Cream of the Crop 1/Cream of the Crop 1.iso/SOUND/THEDECK1.ARJ/THEDECK1.BAS

BASIC Source File | 1991-10-16 | 36KB | 1,361 lines

DECLARE SUB ButtonSelect (ButtonNumber%, OnOff%)
DECLARE SUB ClearButtons (first%, last%)
DECLARE SUB DelayOnPort (times%)
DECLARE SUB DemoInit ()
DECLARE SUB DoHelpInfo ()
DECLARE SUB DoLoadMIDI ()
DECLARE SUB DoLoadVOC ()
DECLARE SUB DoPauseMIDI (OnOff%)
DECLARE SUB DoPauseVOC (OnOff%)
DECLARE SUB DoPlayMIDI ()
DECLARE SUB DoPlayVoc ()
DECLARE SUB DoRecordVOC ()
DECLARE SUB DoScreenMIDI ()
DECLARE SUB DoStopMIDI ()
DECLARE SUB DoStopVOC ()
DECLARE SUB DrawPanel ()
DECLARE SUB FlashButton ()
DECLARE SUB GetInput (prompt$, answer$)
DECLARE FUNCTION GetKeyPick% (waitfor%)
DECLARE FUNCTION GetMousePick% (MouseButtonState%)
DECLARE SUB MouseFunc (func%, IM AS ANY, OM AS ANY)
DECLARE SUB MouseOnOff (OnOff%)
DECLARE FUNCTION SelectEvent% ()
DECLARE SUB SetAutoPlay ()
DECLARE SUB SetColor (fore%, back%)
DECLARE SUB SetLocate (row%, col%)
DECLARE SUB SetPrint (strg$, CR%)
DECLARE SUB SoundEffects (effnumber%)

'in QBXSNDxx.QLB only
DECLARE SUB INTERRUPTX (intnum%, ireg AS ANY, oreg AS ANY)

REM $INCLUDE: 'QBXSOUND.BI'

DEFINT A-Z
'TheDECK (C)1991 Cornel Huth - All Rights Reserved
'16-Oct-91
'C>bc playdemo /o/e/ah/v

'----
TYPE ButtonInfoTYPE
x0 AS INTEGER   'col
y0 AS INTEGER   'row
xs AS INTEGER   'cols
ys AS INTEGER   'rows
END TYPE

TYPE RegTYPEx   'interface structure to INTERRUPTX
ax AS INTEGER
bx AS INTEGER
cx AS INTEGER
dx AS INTEGER
bp AS INTEGER
si AS INTEGER
di AS INTEGER
flags AS INTEGER
ds AS INTEGER
es AS INTEGER
END TYPE

TYPE MouseTYPE  'interface structure to MOUSEFUNC
ax AS INTEGER
bx AS INTEGER
cx AS INTEGER
dx AS INTEGER
END TYPE

TYPE BigChunkTYPE  'for BASIC file I/O
BigChunk AS STRING * 8192
END TYPE

'----
CONST MAXBUTTONS = 17

DIM SHARED gActiveButton
DIM SHARED gFG          'color tracker
DIM SHARED gBG          'color tracker
DIM SHARED gRow         'row tracker (ni)
DIM SHARED gCol         'col tracker (ni)
DIM SHARED gMouse       '1=use mouse also
DIM SHARED gFMinit      '1=FM capable
DIM SHARED gMIDIinit    '1=MIDI init'ed
DIM SHARED gVOCinit     '1=VOC capable and init'ed
DIM SHARED gMIDIloaded  '1=file loaded
DIM SHARED gVOCloaded   '1=file loaded
DIM SHARED gAutoPlay    '0=single play,1=auto MIDI,2=auto VOC,3=MIDI-VOC-MIDI...

DIM SHARED xreg AS RegTYPEx
DIM SHARED IM AS MouseTYPE
DIM SHARED OM AS MouseTYPE

REDIM SHARED gButtonInfo(1 TO MAXBUTTONS) AS ButtonInfoTYPE
REDIM SHARED mbuff(1 TO 1) AS BigChunkTYPE
REDIM SHARED vbuff(1 TO 1) AS BigChunkTYPE

DemoInit
DO
   IF xevent >= 0 THEN xevent = SelectEvent
   IF ABS(xevent) = 13 THEN
      xevent = 0
      SELECT CASE gActiveButton
      CASE 1    'eject (load MIDI file)
         DoLoadMIDI
         gMIDIloaded = 1
      CASE 2    'eject (load VOC file)
         DoLoadVOC
         gVOCloaded = 1
      '-----
      CASE 3    'rewind MIDI (restart)
         IF gMIDIloaded THEN SoundEffects 1
         ClearButtons 3, 3
         DoPlayMIDI
         stat = MusicInfo(voc, note, vol, mode, MusicPtr&)
         IF stat THEN
            ButtonSelect 4, 1
            gActiveButton = 4
            MIDIpause = 0
            MIDIstarted = 1
         END IF
      CASE 4    'play MIDI
         DoPlayMIDI
         stat = MusicInfo(voc, note, vol, mode, MusicPtr&)
         IF stat THEN
            MIDIpause = 0
            MIDIstarted = 1
         END IF
      CASE 5    'FF MIDI
         SoundEffects 2
         ClearButtons 5, 5
         'not implemented
      CASE 6    'stop MIDI
         DoStopMIDI
         MIDIpause = 0
         MIDIstarted = 0
      CASE 7    'pause/cont MIDI
         MIDIpause = NOT MIDIpause
         DoPauseMIDI MIDIpause
      '-----
      CASE 8    'record VOC
         ClearButtons 8, 8
         DoRecordVOC
      CASE 9    'rewind VOC (restart)
         IF gVOCloaded THEN SoundEffects 1
         ClearButtons 9, 9
         DoPlayVoc
         stat = VOCinfo(BT, SR)
         IF stat THEN
            ButtonSelect 10, 1
            gActiveButton = 10
            PauseVOC = 0
            VOCstarted = 1
         END IF
      CASE 10   'play VOC
         DoPlayVoc
         stat = VOCinfo(BT, SR)
         IF stat THEN
            PauseVOC = 0
            VOCstarted = 1
         END IF
      CASE 11   'FF VOC
         SoundEffects 2
         ClearButtons 11, 11
         'not implemented
      CASE 12   'stop VOC
         DoStopVOC
         PauseVOC = 0
         VOCstarted = 0
      CASE 13    'pause/cont VOC
         PauseVOC = NOT PauseVOC
         DoPauseVOC PauseVOC
      CASE 14    'INFO
         DoHelpInfo
      CASE 15    'QUIT
         xevent = 27
      '------
      'if both MIDI and VOC are autoplay then MIDI plays, the VOC, then MIDI...
      CASE 16   'activate auto-play of MIDI
         IF gMIDIloaded THEN
            IF gAutoPlay AND 1 THEN
               gAutoPlay = gAutoPlay AND &HFFFE
            ELSE
               gAutoPlay = gAutoPlay OR 1
            END IF
            SetAutoPlay
         END IF
      CASE 17   'activate auto-play of VOC
         IF gVOCloaded THEN
            IF gAutoPlay AND 2 THEN
               gAutoPlay = gAutoPlay AND &HFFFD
            ELSE
               gAutoPlay = gAutoPlay OR 2
            END IF
            SetAutoPlay
         END IF
      CASE ELSE
      END SELECT
   END IF

   IF gMIDIinit THEN
      stat = MusicInfo(voc, note, vol, mode, MusicPtr&)
      IF stat THEN
         DoScreenMIDI
      ELSEIF MIDIstarted AND VOCstarted = 0 THEN
         MIDIstarted = 0
         xevent = -13
         SELECT CASE gAutoPlay
         CASE 0
            xevent = 0
         CASE 1
            gActiveButton = 4
         CASE 2
            gActiveButton = 10
         CASE 3
            gActiveButton = 10
         CASE ELSE
         END SELECT
      ELSEIF stat = 0 THEN
         MIDIstarted = 0
      END IF
      IF stat = 0 THEN DoScreenMIDI
   END IF

   IF gVOCinit THEN
      stat = VOCinfo(BT, SR)
      IF stat THEN
         'DoScreenVOC
      ELSEIF VOCstarted AND MIDIstarted = 0 THEN
         VOCstarted = 0
         xevent = -13
         SELECT CASE gAutoPlay
         CASE 0
            xevent = 0
         CASE 1
            gActiveButton = 4
         CASE 2
            gActiveButton = 10
         CASE 3
            gActiveButton = 4
         CASE ELSE
         END SELECT
      ELSEIF stat = 0 THEN
         VOCstarted = 0
      END IF
   END IF

LOOP UNTIL xevent = 27
MouseOnOff 0

ShutDown:
CLOSE
MouseFunc 0, IM, OM
gMouse = 0
LOCATE 25, 1: PRINT SPACE$(80);

IF gFMinit THEN
   MusicEnd
   FOR voc = 0 TO 10
      NoteOff voc
   NEXT
END IF

IF gVOCinit THEN nix = VOCend

LOCATE 1, 1
SELECT CASE ErrCode
CASE 0
   e$ = ""
CASE 7
   e$ = "File too large."
CASE 52, 53, 64, 68, 75, 76
   e$ = "Pathname not found."
CASE 248
   e$ = "SoundBlaster/compatible required for VOC."
CASE 249
   e$ = "AdLib/compatible required for MIDI."
CASE 250
   e$ = "MIDI file has more than single track."
CASE ELSE
   e$ = "BASIC error" + STR$(ErrCode) + ". Program ending."
END SELECT
PRINT e$;
DelayOnPort 20000
LOCATE 24, 1
PRINT
PRINT "TheDECK v1.00 (C)1991 Cornel Huth                                    16-Oct-1991"
PRINT
PRINT "This is a demonstration program for a QuickBASIC/BASIC PDS link library called"
PRINT "QBXSNDxx (xx=latest version number). If you'd like to obtain the link library"
PRINT "for inclusion into your own programs select the desired package level that you"
PRINT "require and place an order to the address below with full payment (check, MO)."
PRINT
PRINT "QBXSOUND Programmer link LIB with background MIDI music, DMA VOC input/output,"
PRINT "and programmer's manual on disk:"
PRINT
PRINT "    QuickBASIC 4.0a, 4.0b, 4.5 versions ONLY . . . . . . . $ 9.95"
PRINT
PRINT "QBXSOUND Professional link LIB with background MIDI music, DMA VOC input/output,"
PRINT "direct FM chip access (for special sound effects), all BASIC source code for"
PRINT "custom changes and BASIC 7.x custom compiler matching, plus a bound, printed"
PRINT "programmer's manual:"
PRINT
PRINT "    QuickBASIC 4.0a, 4.0b, 4.5, and QBX/BC 7.x . . . . . . $49.95"
PRINT
PRINT "Check must be on a US BANK and in US DOLLARS only and payable to:"
PRINT
PRINT "    Cornel Huth                          CANADA and Foreign orders"
PRINT "    6402 Ingram Rd.                      add $5.00 for shipping"
PRINT "    San Antonio, TX 78238-3915  U.S.A";
END

'----
'disk i/o error handler
'shut everything down and exit program
DiskHandler:
ErrCode = ERR
RESUME ShutDown

'----
'button x/y positions and x/y size
ButtonInfo:
'eject
DATA 37,5,3,2
DATA 41,5,3,2
'MIDI Track
DATA  6,12,4,2
DATA 11,12,6,2
DATA 18,12,4,2
DATA 23,12,6,2
DATA 30,12,5,2
'VOC Track
DATA 45,12,3,2
DATA 49,12,4,2
DATA 54,12,6,2
DATA 61,12,4,2
DATA 66,12,6,2
DATA 73,12,5,2
'F1=INFO,ESC=QUIT
DATA 38,17,4,2
DATA 38,21,4,2
'AUTO
DATA 37,7,3,2
DATA 41,7,3,2

SUB ButtonSelect (ButtonNumber, OnOff)

'select/deselect button by highlighting/normaling it
'note x's are column position info, y's are row position info

tFG = gFG
tBG = gBG
IF OnOff = 0 THEN SetColor 7, 0 ELSE SetColor 15, 0

x0 = gButtonInfo(ButtonNumber).x0
y0 = gButtonInfo(ButtonNumber).y0
xs = gButtonInfo(ButtonNumber).xs
ys = gButtonInfo(ButtonNumber).ys
x1 = x0 + xs - 1
y1 = y0 + ys - 1

SetLocate y0, x0
SetPrint "┌", 0
FOR i = 1 TO xs - 2
   SetPrint "─", 0
NEXT
SetPrint "┐", 1

FOR i = 1 TO ys - 2     'not currently needed since button height=2 (ys)
   SetLocate -1, x0
   SetPrint "│", 0
   SetLocate -1, x1
NEXT

SetLocate y1, x0
SetPrint "└", 0
FOR i = 1 TO xs - 2
   SetPrint "─", 0
NEXT
SetPrint "┘", 1

SetColor tFG, tBG

END SUB

SUB ClearButtons (first, last)

'clear buttons

FOR i = first TO last
   ButtonSelect i, 0
NEXT

END SUB

SUB DelayOnPort (times)

'somewhat constant delay by reading through the IO bus
'times=10000 is about 1 second (50,000 INPs)

FOR i = 1 TO times
   nix = INP(&H372)
   nix = INP(&H372)
   nix = INP(&H372)
   nix = INP(&H372)
   nix = INP(&H372)
NEXT

END SUB

SUB DemoInit

CLS

SetColor 7, 0
SetLocate 1, 1

gActiveButton = 1

'get button info
RESTORE ButtonInfo
FOR i = 1 TO MAXBUTTONS
   READ x0, y0, xs, ys
   gButtonInfo(i).x0 = x0  'col
   gButtonInfo(i).y0 = y0  'row
   gButtonInfo(i).xs = xs  'cols
   gButtonInfo(i).ys = ys  'rows
NEXT

DrawPanel

MouseFunc 0, IM, OM: gMouse = OM.ax
IM.cx = 296: IM.dx = 32: MouseFunc 4, IM, OM
MouseOnOff 1
ButtonSelect gActiveButton, 1

stat = SoundColdInit(-1)        'test FM music ability (use port 388h)
IF stat = 0 THEN
   gFMinit = 1    'FM okay
   MusicInit 1    'start up the MIDI Music Player
END IF

port = -1: irq = -1: DMA = 1
stat = VOCinit(port, irq, DMA)  'test and auto configure SoundBlaster
SetLocate 24, 45
IF stat = 0 THEN
   gVOCinit = 1   'VOC okay
   SetPrint "IO:" + HEX$(port) + " IRQ:" + HEX$(irq), 0
ELSE
   SetPrint "IO:n/a", 0
END IF

END SUB

SUB DoHelpInfo

'about this program

MouseOnOff 0
DoPauseMIDI 1
REDIM sbuff(0 TO 2000)
DEF SEG = &H0: t = PEEK(&H463): DEF SEG
IF t = &HD4 THEN VideoSeg = &HB800 ELSE VideoSeg = &HB000

vseg = VARSEG(sbuff(0))
voff = VARPTR(sbuff(0))
FOR i = 0 TO 3999
   DEF SEG = VideoSeg
   vbyte = PEEK(i)
   DEF SEG = vseg
   POKE i, vbyte
NEXT
DEF SEG
DoPauseMIDI 0

CLS
PRINT "Press a key or mouse button to RETURN.─────────────────────────────────────────┐";
PRINT "│                00000   To SELECT function use TAB/shift-TAB or Mouse        ∞│";
PRINT "│   ┌─────────────│───────────────┐         ┌──────────────────────────────┐   │";
PRINT "│   │        byte counter         │  EJECT  │                              │   │";
PRINT "│   │                         ┌────>┌─┐ ┌─┐<────┐                          │   │";
PRINT "│   │ Use to load a MIDI file ┘   │ └─┘ └─┘ │   └ Use to load a VOC file   │   │";
PRINT "│   │                             │ ┌─┐ ┌─┐ │                              │   │";
PRINT "│   │                         ┌────>└─┘ └─┘<─┐                             │   │";
PRINT "│   │ Continuous-Auto Play ───┘   │   CAP   │└ either MIDI,VOC,or MIDI+VOC │   │";
PRINT "│   └─────────────────────────────┘         └──────────────────────────────┘   │";
PRINT "│     <<   PLAY   >>   STOP  PAUSE          REC  <<   PLAY   >>   STOP  PAUSE  │";
PRINT "│    ┌──┐ ┌────┐ ┌──┐ ┌────┐ ┌───┐          ┌─┐ ┌──┐ ┌────┐ ┌──┐ ┌────┐ ┌───┐  │";
PRINT "│∞   └──┘ └────┘ └──┘ └────┘ └───┘          └─┘ └──┘ └────┘ └──┘ └────┘ └───┘ ∞│";
PRINT "│┌──────────────────────────────────┐∞  ∞┌───│────────────────────│────────│──┐│";
PRINT "└┤ │  │  │  │  │  │  │  │  │  │  │  ├────┤   │                    │        │  ├┘";
PRINT " │                                  │INFO│ Record and playback on-│the-spot│  │"
PRINT " │ Each AdLib voice is tracked here │┌──┐│                        │        │  │"
PRINT " │ during the playing of a MIDI file│└──┘│ If the tape 'jams' press STOP   │  │"
PRINT " │                                  │    │                                 │  │"
PRINT " │ The ▓ is the relative volume of  │QUIT│ Pause output anytime (toggled)     │"
PRINT " │ the voice and  is the octave    │┌──┐│                                    │"
PRINT " │                                  │└──┘│ SB configuration is auto-detected  │"
PRINT " │ │  │  │  │  │  │  │  │  │  │  │  │ or │      │      │                      │"
PRINT " │∞0  1  2  3  4  5  BD SD TT CY HH∞│ Esc│∞ IO:    IRQ:  (C)1991 Cornel Huth ∞│"
PRINT " └──────────────────────────────────┘    └────────────────────────────────────┘";

DO
   kbkey = GetKeyPick(0)
   IF gMouse THEN
      mbkey = GetMousePick(mbstate)
      IF mbstate THEN kbkey = mbstate
   END IF
LOOP UNTIL kbkey

DoPauseMIDI 1
vseg = VARSEG(sbuff(0))
voff = VARPTR(sbuff(0))
FOR i = 0 TO 3999
   DEF SEG = vseg
   vbyte = PEEK(i)
   DEF SEG = VideoSeg
   POKE i, vbyte
NEXT
DEF SEG
DoPauseMIDI 0
MouseOnOff 1

END SUB

SUB DoLoadMIDI

'get MIDI filename
'load MIDI file into a 64K max buffer, mbuff(1..)

ON ERROR GOTO DiskHandler
IF gFMinit = 0 THEN ERROR 249
ON ERROR GOTO 0

GetInput "MIDI filename: ", filename$
IF LEN(filename$) = 0 THEN EXIT SUB

SetLocate 9, 20
tFG = gFG
tBG = gBG
SetColor 15, 0
SetPrint UCASE$(RIGHT$(filename$ + SPACE$(12 - LEN(RIGHT$(filename$, 12))), 12)), 1
SetColor tFG, tBG

ON ERROR GOTO DiskHandler

OPEN filename$ FOR INPUT AS #1  'error out before creating a new file
CLOSE #1

OPEN filename$ FOR BINARY AS #1
length& = LOF(1)
IF length& > 65520 THEN ERROR 7

blocks = (length& \ 8192)
IF length& MOD 8192 THEN blocks = blocks + 1
REDIM mbuff(1 TO blocks) AS BigChunkTYPE

ss = 1
DO WHILE NOT EOF(1)
   GET #1, , mbuff(ss).BigChunk
   ss = ss + 1
LOOP
CLOSE #1

ON ERROR GOTO 0

tapelen = (length& \ 16380) + 1
SetLocate 6, 14
SetPrint STRING$(5, " "), 0
SetLocate 6, 14
SetPrint STRING$(tapelen, ")"), 0
gMIDIinit = 1

END SUB

SUB DoLoadVOC

'get VOC filename
'load VOC file into a max buffer, vbuff(1..)

ON ERROR GOTO DiskHandler
IF gVOCinit = 0 THEN ERROR 248
ON ERROR GOTO 0

GetInput "VOC filename: ", filename$
IF LEN(filename$) = 0 THEN EXIT SUB

SetLocate 9, 60
tFG = gFG
tBG = gBG
SetColor 15, 0
SetPrint UCASE$(RIGHT$(filename$ + SPACE$(12 - LEN(filename$)), 12)), 1
SetColor tFG, tBG

ON ERROR GOTO DiskHandler

OPEN filename$ FOR INPUT AS #1  'error out before creating a new file
CLOSE #1

OPEN filename$ FOR BINARY AS #1
length& = LOF(1)
IF length& > 524288 THEN ERROR 7

blocks = (length& \ 8192)
IF length& MOD 8192 THEN blocks = blocks + 1
REDIM vbuff(1 TO blocks) AS BigChunkTYPE

ss = 1
DO WHILE NOT EOF(1)
   GET #1, , vbuff(ss).BigChunk
   ss = ss + 1
LOOP
CLOSE #1

ON ERROR GOTO 0

tapelen = (length& \ 65536) + 1
IF tapelen > 5 THEN tapelen = 5
SetLocate 6, 54
SetPrint STRING$(5, " "), 0
SetLocate 6, 54
SetPrint STRING$(tapelen, ")"), 0

END SUB

SUB DoPauseMIDI (OnOff)

'pause/continue playing of the MIDI file

IF gMIDIloaded = 0 THEN EXIT SUB

IF OnOff THEN
   MusicPause
ELSE
   MusicCont
END IF

END SUB

SUB DoPauseVOC (OnOff)

'pause/continue playing of the VOC file

IF gVOCloaded = 0 THEN EXIT SUB

IF OnOff THEN
   nix = VOCpause
ELSE
   nix = VOCcont
END IF

END SUB

SUB DoPlayMIDI

'play the MIDI file

IF gMIDIloaded = 0 THEN EXIT SUB

vseg = VARSEG(mbuff(1))
voff = VARPTR(mbuff(1))
stat = MusicPlay(vseg, voff)

END SUB

SUB DoPlayVoc

'play the VOC file

IF gVOCloaded = 0 THEN EXIT SUB

stat = VOCinfo(CurrBlockType, CurrSampleRate)
IF stat THEN EXIT SUB   'already active

vseg = VARSEG(vbuff(1))
voff = VARPTR(vbuff(1))
stat = VOCplay(vseg, voff)

END SUB

SUB DoRecordVOC

'get VOC sample rate and seconds to record
'store VOC data into a max buffer, vbuff(1..)
'save it? left to the programmer (or use VoxKit)

ON ERROR GOTO DiskHandler
IF gVOCinit = 0 THEN ERROR 248
ON ERROR GOTO 0

MouseOnOff 0
GetInput "Enter sample rate (5000-11000):", SampleRate$
t& = VAL(SampleRate$)
IF t& < 5000 THEN t& = 5000
IF t& > 11000 THEN t& = 11000
SR = CINT(t&)
maxfre& = FRE(-1) - 64000
maxsecs = maxfre& \ SR
GetInput "Enter seconds to record (1-" + LTRIM$(STR$(maxsecs)) + "):", Second$
t& = VAL(Second$)
IF t& < 1 THEN t& = 1
IF t& > maxsecs THEN t& = maxsecs
rbytes& = t& * SR

blocks = (rbytes& \ 8192)
IF rbytes& MOD 8192 THEN blocks = blocks + 1
REDIM vbuff(1 TO blocks) AS BigChunkTYPE

GetInput "Press <Enter> to start recording", nix$
vseg = VARSEG(vbuff(1))
voff = VARPTR(vbuff(1))
stat = VOCrecord(SR, rbytes&, vseg, voff)
DO
   stat = VOCinfo(CBT, CSR)
LOOP WHILE stat
GetInput "Press <Enter> to start playback", nix$
stat = VOCplay(vseg, voff)
DO
   stat = VOCinfo(CBT, CSR)
LOOP WHILE stat

REDIM vbuff(1 TO 1) AS BigChunkTYPE
MouseOnOff 1

END SUB

SUB DoScreenMIDI STATIC

'show MIDI info screen

DIM lastmode
DIM VolInfo(0 TO 10)
DIM NoteInfo(0 TO 10)

IF gMIDIloaded = 0 THEN EXIT SUB

stat = MusicInfo(0, note, vol, mode, MusicPtr&)
IF MusicPtr& < 0 THEN MusicPtr& = 0
SetLocate 2, 18
SetPrint RIGHT$("00000" + LTRIM$(STR$(MusicPtr&)), 5), 1

IF lastmode <> (mode - 1) THEN
   IF mode = 0 THEN
      maxvoc = 8
      SetLocate 24, 22
      SetPrint "6  7  8       ", 0
      lastmode = -1
   ELSE
      maxvoc = 10
      SetLocate 24, 22
      SetPrint "BD SD TT CY HH", 0
      lastmode = -2
   END IF
END IF

ERASE VolInfo
ERASE NoteInfo
FOR voc = 0 TO maxvoc
   stat = MusicInfo(voc, note, vol, mode, MusicPtr&)
   IF vol > 127 THEN vol = 127     'MIDI levels
   IF note > 127 THEN note = 127   ' "     "
   IF stat THEN VolInfo(voc) = (vol + 1) \ 16
   IF stat THEN NoteInfo(voc) = (note + 1) \ 16
NEXT

FOR voc = 0 TO maxvoc
   col = 4 + (voc * 3)
   LOCATE 15, col
   FOR i = 1 TO 9
      LOCATE , col
      PRINT "│ "
   NEXT
   LOCATE 23 - VolInfo(voc), col
   IF VolInfo(voc) > 7 THEN COLOR 4, 0 ELSE COLOR 2, 0
   PRINT "▓"
   COLOR 7, 0
   LOCATE 23 - NoteInfo(voc), col + 1
   PRINT ""
NEXT

END SUB

SUB DoScreenVOC

'nyi

END SUB

SUB DoStopMIDI

'shut down the MIDI Music Player

IF gMIDIinit THEN
   MusicEnd     'shut it down
   MusicInit 1  'start it back up
END IF

END SUB

SUB DoStopVOC

'shut down the VOC player

IF gVOCinit THEN nix = VOCend

END SUB

SUB DrawPanel

MouseOnOff 0
VIEW PRINT 1 TO 25
CLS
      '123456789-123456789-123456789-123456789-123456789-123456789-123456789-123456789-
PRINT "┌──────────────────────────────────────────────────────────────────────────────┐";
PRINT "│∞               00000                 ∞                 ......               ∞│";
PRINT "│   ┌─────────────────────────────┐         ┌──────────────────────────────┐   │";
PRINT "│   │                             │  EJECT  │                              │   │";
PRINT "│   │      ┌───────────────┐      │ ┌─┐ ┌─┐ │      ┌────────────────┐      │   │";
PRINT "│   │      │)             (│      │ └─┘ └─┘ │      │)              (│      │   │";
PRINT "│   │      └───────────────┘      │ ┌─┐ ┌─┐ │      └────────────────┘      │   │";
PRINT "│   │                             │ └─┘ └─┘ │                              │   │";
PRINT "│   │  MIDI Track:                │   CAP   │   VOC Track:                 │   │";
PRINT "│   └─────────────────────────────┘         └──────────────────────────────┘   │";
PRINT "│     <<   PLAY   >>   STOP  PAUSE          REC  <<   PLAY   >>   STOP  PAUSE  │";
PRINT "│    ┌──┐ ┌────┐ ┌──┐ ┌────┐ ┌───┐          ┌─┐ ┌──┐ ┌────┐ ┌──┐ ┌────┐ ┌───┐  │";
PRINT "│∞   └──┘ └────┘ └──┘ └────┘ └───┘          └─┘ └──┘ └────┘ └──┘ └────┘ └───┘ ∞│";
PRINT "│┌──────────────────────────────────┐∞  ∞┌────────────────────────────────────┐│";
PRINT "└┤ │  │  │  │  │  │  │  │  │  │  │  ├────┤  ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░  ├┘";
PRINT " │∞│  │  │  │  │  │  │  │  │  │  │ ∞│INFO│∞ ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░ ∞│"
PRINT " │ │  │  │  │  │  │  │  │  │  │  │  │┌──┐│  ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░  │"
PRINT " │ │  │  │  │  │  │  │  │  │  │  │  │└──┘│  ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░  │"
PRINT " │ │  │  │  │  │  │  │  │  │  │  │  │    │  ▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒  │"
PRINT " │ │  │  │  │  │  │  │  │  │  │  │  │QUIT│  ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░  │"
PRINT " │ │  │  │  │  │  │  │  │  │  │  │  │┌──┐│  ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░  │"
PRINT " │ │  │  │  │  │  │  │  │  │  │  │  │└──┘│  ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░  │"
PRINT " │ │  │  │  │  │  │  │  │  │  │  │  │    │  ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░  │"
PRINT " │∞0  1  2  3  4  5  6  7  8  .  . ∞│    │∞ IO:    IRQ:  (C)1991 Cornel Huth ∞│"
PRINT " └──────────────────────────────────┘    └────────────────────────────────────┘";
      '123456789-123456789-123456789-123456789-123456789-123456789-123456789-123456789-

MouseOnOff 1

END SUB

SUB FlashButton

'flash the active button

ButtonSelect gActiveButton, 0
DelayOnPort 500
ButtonSelect gActiveButton, 1
DelayOnPort 500

END SUB

SUB GetInput (prompt$, answer$)

'get user input from line 1

SetLocate 1, 1
SetPrint SPACE$(80), 0
SetLocate 1, 1
SetPrint prompt$, 0
LINE INPUT answer$
SetLocate 1, 1
SetPrint "┌──────────────────────────────────────────────────────────────────────────────┐", 0

END SUB

FUNCTION GetKeyPick (waitfor)

'get a key, if waitfor then wait until a key

DO
   kb$ = INKEY$
   kblen = LEN(kb$)
   SELECT CASE kblen
   CASE 0
     kbkey = 0
   CASE 1
      kbkey = ASC(kb$)
   CASE 2
      kbkey = 1000 + ASC(RIGHT$(kb$, 1))
   CASE ELSE
   END SELECT
LOOP UNTIL kbkey OR (waitfor = 0)
GetKeyPick = kbkey

END FUNCTION

FUNCTION GetMousePick (MouseButtonState)

'if mouse left button down and cursor is on a event button then
'set gActiveButton and return 13 else just return 0

'bx=button status
'cx=horz cursor coor
'dx=vert cursor coor

MouseFunc 3, IM, OM
MouseButtonState = OM.bx

match = 0
IF OM.bx = 1 THEN
   mx = OM.cx \ 8
   my = OM.dx \ 8

   FOR i = 1 TO MAXBUTTONS
      x0 = gButtonInfo(i).x0 - 1   '0-base it
      y0 = gButtonInfo(i).y0 - 1
      x1 = x0 + gButtonInfo(i).xs - 1
      y1 = y0 + gButtonInfo(i).ys - 1

      'check for match in horz and vert positions

      IF mx >= x0 AND mx <= x1 THEN
         IF my >= y0 AND my <= y1 THEN
            gActiveButton = i
            match = 13
            EXIT FOR
         END IF
      END IF
   NEXT

END IF
GetMousePick = match

END FUNCTION

SUB MouseFunc (func, IM AS MouseTYPE, OM AS MouseTYPE)

'hey, a complete mouse function routine

IF gMouse = 0 AND func > 0 THEN EXIT SUB

xreg.es = -1    'IM.ax used to pass ES segment register if needed
SELECT CASE func
CASE 0   'MOUSE RESET AND STATUS
         'set: nothing
         'rtn: ax=status (0=not found/not reset)
         '     bx=buttons
   DEF SEG = 0
   MouseSeg = PEEK(206) + 256 * PEEK(207)
   MouseOff = PEEK(204) + 256 * PEEK(205)
   DEF SEG = MouseSeg
   MouseExists = (MouseSeg <> 0 OR MouseOff <> 0) AND PEEK(MouseOff) <> &HCF
   DEF SEG
   IF MouseExists THEN xreg.ax = 0 ELSE OM.ax = 0: EXIT SUB
CASE 1   'SHOW CURSOR
         'set: nothing
         'rtn: nothing
   xreg.ax = 1
CASE 2   'HIDE CURSOR
         'set: nothing
         'rtn: nothing
   xreg.ax = 2
CASE 3   'GET BUTTON STATUS AND MOUSE POS
         'set: nothing
         'rtn: bx=button status
         '     cx=horz cursor coor
         '     dx=vert cursor coor
   xreg.ax = 3
CASE 4   'SET MOUSE CURSOR POS
         'set: cx=new horz cursor pos
         '     dx=new vert cursor pos
         'rtn: nothing
   xreg.ax = 4
   xreg.cx = IM.cx
   xreg.dx = IM.dx
CASE 5   'GET BUTTON PRESS INFO
         'set: bx=button
         'rtn: ax=button status
         '     bx=number of button presses
         '     cx=horz cursor coor at last press
         '     dx=vert cursor coor at last press
   xreg.ax = 5
   xreg.bx = IM.bx
CASE 6   'GET BUTTON RELEASE INFO
         'set: bx=button
         'rtn: ax=button status
         '     bx=number of button releases
         '     cx=horz cursor coor at last release
         '     dx=vert cursor coor at last release
   xreg.ax = 6
   xreg.bx = IM.bx
CASE 7   'SET MIN AND MAX HORZ CURSOR POS
         'set: cx=min pos
         '     dx=max pos
         'rtn: nothing
   xreg.ax = 7
   xreg.cx = IM.cx
   xreg.dx = IM.dx
CASE 8   'SET MIN AND MAX VERT CURSOR POS
         'set: cx=min pos
         '     dx=max pos
         'rtn: nothing
   xreg.ax = 8
   xreg.cx = IM.cx
   xreg.dx = IM.dx
CASE 9   'SET GRAPHICS CURSOR BLOCK
         'set: ax=segment of cursor mask (NEVER DEFAULT)
         '     bx=horz cursor hot spot
         '     cx=vert cursor hot spot
         '     dx=pointer to screen
         'rtn: nothing
   xreg.ax = 9
   xreg.bx = IM.bx
   xreg.cx = IM.cx
   xreg.dx = IM.dx
   xreg.es = IM.ax
CASE 10  'SET TEXT CURSOR
         'set: bx=cursor select
         '     cx=screen mask value or scan line start
         '     dx=cursor mask value or scan line start
         'rtn: nothing
   xreg.ax = 10
   xreg.bx = IM.bx
   xreg.cx = IM.cx
   xreg.dx = IM.dx
CASE 11  'READ MOUSE MOTION COUNTERS
         'set: nothing
         'rtn: cx=horz mickey count
         '     dx=vert mickey count
   xreg.ax = 11
CASE 12  'SET INTERRUPT SUBROUTINE CALL MASK AND ADDRESS
         'set: ax=segment of subroutine (NEVER DEFAULT)
         '     cx=call mask.........bit 0-cursor pos changed
         '     dx=offset of subroutine '1-left button pressed
         'rtn: nothing                 '2-left button released
   xreg.ax = 12                        '3-right button pressed
   xreg.cx = IM.cx                     '4-right button released
   xreg.dx = IM.dx                     '5-15 not used
   xreg.es = IM.ax
CASE 13  'LIGHT PEN EMULATION MODE ON
         'set: nothing
         'rtn: nothing
   xreg.ax = 13
CASE 14  'LIGHT PEN EMULATION MODE OFF
         'set: nothing
         'rtn: nothing
   xreg.ax = 14
CASE 15  'SET MICKEY/PIXEL RATIO
         'set: cx=horz mickey to pixel ratio
         '     dx=vert mickey to pixel ratio
         'rtn: nothing
   xreg.ax = 15
   xreg.cx = IM.cx
   xreg.dx = IM.dx
CASE 16  'CONDITIONAL OFF
         'set: ax=left x (slightly different than regular calling registers)
         '     bx=upper y
         '     cx=right x
         '     dx=lower y
         'rtn: nothing
   xreg.ax = 16
   xreg.cx = IM.ax
   xreg.dx = IM.bx
   xreg.si = IM.cx
   xreg.di = IM.dx
CASE 17, 18
CASE 19  'SET DOUBLE-SPEED THRESHOLD
         'set: dx=threshold speed in mickeys/seconds
         'rtn: nothing
   xreg.ax = 19
   xreg.dx = IM.dx
CASE 20  'SWAP INTERRUPT ROUTINES
         'set: ax=segment of subroutine (NEVER DEFAULT)
         '     cx=call mask (as in func 12 above)
         '     dx=offset of subroutine        ***********************
         'rtn: bx=segment of old subroutine   *Rtn values valid only*
         '     cx=call mask of old subroutine *if previous interrupt*
         '     dx=offset of old subroutine    *was created          *
   xreg.ax = 20                              '***********************
   xreg.cx = IM.cx
   xreg.dx = IM.dx
   xreg.es = IM.ax
   INTERRUPTX &H33, xreg, xreg
   OM.ax = 0
   OM.bx = xreg.es
   OM.cx = xreg.cx
   OM.dx = xreg.dx
   EXIT SUB
CASE 21  'GET MOUSE DRIVER STATE STORAGE REQUIREMENTS
         'set: nothing
         'rtn: bx=buffer size in bytes
   xreg.ax = 21
CASE 22  'SAVE MOUSE DRIVER STATE
         'set: ax=segment of buffer
         '     dx=offset of buffer
         'rtn: nothing
   xreg.ax = 22
   xreg.dx = IM.dx
   xreg.es = IM.ax
CASE 23  'RESTORE MOUSE DRIVER STATE
         'set: ax=segment of buffer
         '     dx=offset of buffer
         'rtn: nothing
   xreg.ax = 23
   xreg.dx = IM.dx
   xreg.es = IM.ax
CASE 24  'SET ALTERNATE SUBROUTINE CALL MASK AND ADDRESS
         'set: ax=segment of user subroutine
         '     cx=call mask.........bit 0-cursor pos changed
         '     dx=offset of subroutine '1-left button pressed
         'rtn: ax=error status (-1)    '2-left button released
   xreg.ax = 24                        '3-right button pressed
   xreg.cx = IM.cx                     '4-right button released
   xreg.dx = IM.dx                     '5-shift key down w/button
   xreg.es = IM.ax                     '6-ctrl key down w/button
                                       '7-alt key down w/button
                                       '8-15 not used
CASE 25  'GET USER ALTERNATE INTERRUPT ADDRESS
         'set: cx=user interrupt call mask
         'rtn: ax=error status (-1)
         '     bx=segment of user subroutine
         '     cx=call mask of user interrupt
         '     dx=offset of subroutine
   xreg.ax = 25
   xreg.cx = IM.cx
CASE 26  'SET MOUSE SENSITIVITY
         'set: bx=horz mickey sensitivity (0 to 100)  these all
         '     cx=vert mickey sensitivity (0 to 100)   have default
         '     dx=threshold for double speed (0 to 100) values=50
         'rtn: nothing
   xreg.ax = 26
   xreg.bx = IM.bx
   xreg.cx = IM.cx
   xreg.dx = IM.dx
CASE 27  'GET MOUSE SENSITIVITY
         'set: nothing
         'rtn: bx=horz mickey sensitivity (0 to 100)
         '     cx=vert mickey sensitivity (0 to 100)
         '     dx=threshold for double speed (0 to 100)
   xreg.ax = 27
CASE 28  'SET MOUSE INTERRUPT RATE (InPort mouse ONLY)
         'set: bx=rate number (0 (0/sec) to 4 (200/sec))
         'rtn: nothing
   xreg.ax = 28
   xreg.bx = IM.bx
CASE 29  'SET CRT PAGE NUMBER
         'set: bx=CRT page for mouse cursor display
         'rtn: nothing
   xreg.ax = 29
   xreg.bx = IM.bx
CASE 30  'GET CRT PAGE NUMBER
         'set: nothing
         'rtn: bx=CRT page for current mouse cursor display
   xreg.ax = 30
CASE 31  'DISABLE MOUSE DRIVER
         'set: nothing
         'rtn: ax=error status (-1)
         '     bx=segment of old int 33h
         '     dx=offset of old int 33h
   xreg.ax = 31
   INTERRUPTX &H33, xreg, xreg
   OM.ax = xreg.ax
   OM.bx = xreg.es
   OM.cx = 0
   OM.dx = xreg.bx
   EXIT SUB
CASE 32  'ENABLE MOUSE DRIVER
         'set: nothing
         'rtn: nothing
   xreg.ax = 32
CASE 33  'SOFTWARE RESET
         'set: nothing
         'rtn: ax=-1 (or 33 if mouse drive not installed)
         '     bx=2 (if ax=-1. Must=2 for a valid reset)
   xreg.ax = 33
CASE 34  'SET LANGUAGE FOR MESSAGES (International MOUSE.xxx ONLY)
         'set: bx=language number
         'rtn: nothing
   xreg.ax = 34
   xreg.bx = IM.bx
CASE 35  'GET LANGUAGE NUMBER
         'set: nothing
         'rtn: bx=language number
   xreg.ax = 35
CASE 36  'GET DRIVER VERSION,MOUSE TYPE,AND IRQ NUMBER
         'set: nothing
         'rtn: bx=mouse driver version number
         '        bh=major
         '        bl=minor
         '     cx=mouse type and IRQ number
         '        ch=mouse type (1=bus,2=serial,3=InPort,4=PS/2,5=HP)
         '        cl=IRQ number (0=PS/2, 2-5 or 7=mouse IRQ)
   xreg.ax = 36
CASE ELSE
   OM.ax = 0
   OM.bx = 0
   OM.cx = 0
   OM.dx = 0
   EXIT SUB
END SELECT

INTERRUPTX &H33, xreg, xreg
OM.ax = xreg.ax
OM.bx = xreg.bx
OM.cx = xreg.cx
OM.dx = xreg.dx

END SUB

SUB MouseOnOff (OnOff)

'turn the mouse cursor on/off

IF OnOff THEN
   MouseFunc 1, IM, OM  'show
ELSE
   MouseFunc 2, IM, OM  'hide
END IF

END SUB

FUNCTION SelectEvent

'determine what's going to happen

tActiveButton = gActiveButton

'read the keyboard for event keys
'-TABs select active button
'-ENTER performs active button
'-mouse supported (left button=select and perform)

kbkey = GetKeyPick(0)
IF gMouse THEN
   mbkey = GetMousePick(mbstate)
   IF mbkey THEN kbkey = mbkey
END IF

SELECT CASE kbkey
CASE 0
CASE 9       'TAB->
   gActiveButton = gActiveButton + 1
   IF gActiveButton > MAXBUTTONS THEN gActiveButton = 1
CASE 1015    '<-TAB
   gActiveButton = gActiveButton - 1
   IF gActiveButton = 0 THEN gActiveButton = MAXBUTTONS
CASE 1059    'F1
   DoHelpInfo
CASE 13
   ExitSub = 13
CASE 27
   ExitSub = 27
CASE ELSE
END SELECT

IF kbkey THEN
   ButtonSelect tActiveButton, 0
   ButtonSelect gActiveButton, 1
   tActiveButton = gActiveButton
   IF ExitSub = 13 THEN FlashButton
END IF

SelectEvent = ExitSub

END FUNCTION

SUB SetAutoPlay

'put the appropriate autoplay icons on the panel

DIM tstr AS STRING * 5
DIM LA AS STRING * 1
DIM RA AS STRING * 1

tstr = " CAP "
LA = CHR$(17)
RA = CHR$(16)

tFG = gFG
tBG = gBG
SetColor 15, 0
SELECT CASE gAutoPlay
CASE 0
   SetColor 7, 0
CASE 1
   MID$(tstr, 1, 1) = LA
CASE 2
   MID$(tstr, 5, 1) = RA
CASE 3
   MID$(tstr, 1, 1) = LA
   MID$(tstr, 5, 1) = RA
CASE ELSE
END SELECT
SetLocate 9, 38
SetPrint tstr, 0
SetColor tFG, tBG

END SUB

SUB SetColor (fore, back)

'all color changes come through here so we can track what's current

gFG = fore
gBG = back
MouseOnOff 0
COLOR fore, back
MouseOnOff 1

END SUB

SUB SetLocate (row, col)

'all locate changes come through here so we can track what's current

MouseOnOff 0
IF row > 0 THEN gRow = row
IF col > 0 THEN gCol = col
IF row > 0 AND col > 0 THEN
   LOCATE row, col
ELSEIF row <= 0 AND col > 0 THEN
   LOCATE , col
ELSEIF row > 0 AND col <= 0 THEN
   LOCATE row
END IF
MouseOnOff 1

END SUB

SUB SetPrint (strg$, CR)

'need to shuffle PRINTs through here so to turn off the mouse cursor

MouseOnOff 0
IF CR = 0 THEN PRINT strg$;  ELSE PRINT strg$
MouseOnOff 1

END SUB

SUB SoundEffects (effnumber)

'we can interrupt the playing MIDI file and pump out some interesting
'sounds (but we have to preserve the FM chip state, easy enough since
'there's a built-in QBXSOUND function
'just play around with this

MusicPause
StateSave
'SetSoundMode 0
InitSlotParms  'w/SoundWarmInit
SELECT CASE effnumber
CASE 1  'a very fast rewind
   FOR note = 75 TO 127
      NoteOn 0, note
      DelayOnPort 100
      NoteOff 0
   NEXT
CASE 2  'a high freq
  NoteOn 0, 127
  DelayOnPort 1000
  NoteOff 0
CASE ELSE
END SELECT
StateRestore
MusicCont

END SUB